home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / cmplibsr.zoo / $asmbgen1.P < prev    next >
Text File  |  1988-09-15  |  9KB  |  239 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona,1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25.  
  26.  
  27. /* begin asmbgen1.P ****************************************************/
  28.  
  29. /* **********************************************************************
  30. $asmbgen1_export([$asm_symbol/1,$asm_putnum/2,$asm_gen/1,$asm_mark_eot/0]).
  31.  
  32. $asmbgen1_use($name,[$name/2,_]).
  33. $asmbgen1_use($bio,[$writename/1,$writeqname/1,$put/1,$nl/0,$tab/1,$tell/1,
  34.     $telling/1,$told/0,$get/1,$get0/1,$see/1,$seeing/1,$seen/0]).
  35. $asmbgen1_use($meta,[_,_,$length/2]).
  36. $asmbgen1_use($blist,[$append/3,$member/2,$member1/2]).
  37. $asmbgen1_use($aux1,[_,_,_,_,$umsg/1,_,_,_,_]).
  38. ********************************************************************** */
  39.  
  40. /* $asm_symbol outputs the PSC table in byte file header format */
  41.  
  42. $asm_symbol(Symtab) :- $member(Sym, Symtab), $asm_putsym(Sym), fail.
  43. $asm_symbol(_).
  44.  
  45. $asm_putsym((String, Arity, Value)) :-
  46.     $asm_putnum(Value, 4),
  47.     $asm_putnum(Arity, 1),
  48.     $conlength(String,L),
  49.     $asm_putnum(L,1),
  50.     $writename(String),
  51.     !.
  52.  
  53. /*    Putnum(Number, Length) will write Number as a binary number
  54. which will be Length bytes long */
  55.  
  56. $asm_putnum(Num,NBytes) :-
  57.     NBytes > 1 ->
  58.         (Byte is Num /\ 255,
  59.          Rest is Num >> 8,
  60.          N is NBytes - 1,
  61.          $asm_putnum(Rest,N),
  62.          $put(Byte)
  63.         ) ;
  64.         (Num < 256, $put(Num)).
  65.  
  66. $asm_opgen(N) :- $asm_putnum(N, 1).
  67. $asm_opgen_even(N) :- $asm_putnum(N, 1), $asm_putnum(0, 1).
  68.  
  69. $asm_strgen(N) :- $asm_putnum(N,4).
  70.  
  71. :- mode($asm_gen,1,[c]).
  72.  
  73. $asm_gen(label(L)).
  74. $asm_gen(pred(I, N)) :- $asm_putnum(I, 4), $asm_putnum(N, 4).
  75. $asm_gen(arglabel(T, Val, L)) :-
  76.     $writename(T),
  77.     (((T ?= i; T ?= c; T ?= s),
  78.      (integer(Val) -> $asm_putnum(Val,4) ; $write4(Val)));
  79.      true
  80.     ),
  81.     $asm_putnum(L, 4).
  82. $asm_gen(getpvar(V,R)) :-
  83.     $asm_opgen_even(0), $asm_putnum(V,1), $asm_putnum(R,1).
  84. $asm_gen(getpval(V,R)) :-
  85.     $asm_opgen_even(1), $asm_putnum(V,1), $asm_putnum(R,1).
  86. $asm_gen(gettval(R,R1)) :-
  87.     $asm_opgen_even(3), $asm_putnum(R,1), $asm_putnum(R1,1).
  88. $asm_gen(getcon(I,R)) :-
  89.     $asm_opgen(4), $asm_putnum(R,1), $asm_putnum(I,4).
  90. $asm_gen(getnil(R)) :-
  91.     $asm_opgen(5), $asm_putnum(R,1).
  92. $asm_gen(getstr(I,R)) :-
  93.     $asm_opgen(6), $asm_putnum(R,1), $asm_strgen(I).
  94. $asm_gen(getstrv(I,V)) :-
  95.     $asm_opgen(2), $asm_putnum(V,1), $asm_strgen(I).
  96. $asm_gen(getlist(R)) :-
  97.     $asm_opgen(7), $asm_putnum(R,1).
  98.  
  99. $asm_gen(getlist_k(R)) :-
  100.     $asm_opgen(70), $asm_putnum(R,1).
  101. $asm_gen(getlist_k_tvar_tvar(R0,R1,R2)) :-
  102.     $asm_opgen(71), $asm_putnum(R0,1), $asm_putnum(R1,1),
  103.     $asm_putnum(R2,1).
  104. $asm_gen(getlist_tvar_tvar(R0,R1,R2)) :-
  105.     $asm_opgen(72), $asm_putnum(R0,1), $asm_putnum(R1,1),
  106.     $asm_putnum(R2,1).
  107. $asm_gen(getcomma(R)) :-
  108.     $asm_opgen(73), $asm_putnum(R,1).
  109. $asm_gen(getcomma_tvar_tvar(R0,R1,R2)) :-
  110.     $asm_opgen(74), $asm_putnum(R0,1), $asm_putnum(R1,1),
  111.     $asm_putnum(R2,1).
  112.  
  113. $asm_gen(unipvar(V)) :- $asm_opgen(8), $asm_putnum(V,1).
  114. $asm_gen(unipval(V)) :- $asm_opgen(9), $asm_putnum(V,1).
  115. $asm_gen(unitvar(R)) :- $asm_opgen(10), $asm_putnum(R,1).
  116. $asm_gen(unitval(R)) :- $asm_opgen(11), $asm_putnum(R,1).
  117. $asm_gen(unicon(I)) :- $asm_opgen_even(12), $asm_putnum(I,4).
  118. $asm_gen(uninil) :- $asm_opgen_even(13).
  119. $asm_gen(test_unifiable(R1,R2,R3)) :-
  120.     $asm_opgen(36),
  121.     $asm_putnum(R1,1), $asm_putnum(R2,1), $asm_putnum(R3,1).
  122.  
  123. $asm_gen(putpvar(V,R)) :-
  124.     $asm_opgen_even(16), $asm_putnum(V,1), $asm_putnum(R,1).
  125. $asm_gen(putpval(V,R)) :-
  126.     $asm_opgen_even(17), $asm_putnum(V,1), $asm_putnum(R,1).
  127. $asm_gen(puttvar(R,R1)) :-
  128.     $asm_opgen_even(18), $asm_putnum(R,1), $asm_putnum(R1,1).
  129. $asm_gen(putcon(I,R)) :- $asm_opgen(20), $asm_putnum(R,1), $asm_putnum(I,4).
  130. $asm_gen(putnil(R)) :- $asm_opgen(21), $asm_putnum(R,1).
  131. $asm_gen(putstr(I,R)) :- $asm_opgen(22),  $asm_putnum(R,1), $asm_strgen(I).
  132. $asm_gen(putstrv(I,V)) :- $asm_opgen(19), $asm_putnum(V,1), $asm_strgen(I).
  133. $asm_gen(putlist(R)) :- $asm_opgen(23), $asm_putnum(R,1).
  134. $asm_gen(bldpvar(V)) :- $asm_opgen(24), $asm_putnum(V,1).
  135. $asm_gen(bldpval(V)) :- $asm_opgen(25), $asm_putnum(V,1).
  136. $asm_gen(bldtvar(R)) :- $asm_opgen(26), $asm_putnum(R,1).
  137. $asm_gen(bldtval(R)) :- $asm_opgen(27), $asm_putnum(R,1).
  138. $asm_gen(bldcon(I)) :- $asm_opgen_even(28), $asm_putnum(I,4).
  139. $asm_gen(bldnil) :- $asm_opgen_even(29).
  140.  
  141. $asm_gen(getnumcon(N,R)) :-
  142.     $asm_opgen(14), $asm_putnum(R,1), $asm_putnum(N,4).
  143. $asm_gen(putnumcon(N,R)) :-
  144.     $asm_opgen(15),  $asm_putnum(R,1), $asm_putnum(N,4).
  145. $asm_gen(uninumcon(I)) :- $asm_opgen_even(30), $asm_putnum(I,4).
  146. $asm_gen(bldnumcon(N)) :- $asm_opgen_even(31), $asm_putnum(N,4).
  147. $asm_gen(getfloatcon(N,R)) :-
  148.     $asm_opgen(32), $asm_putnum(R,1),
  149.     $write4(N).
  150. $asm_gen(putfloatcon(N,R)) :-
  151.     $asm_opgen(33), $asm_putnum(R,1),
  152.     $write4(N).
  153. $asm_gen(unifloatcon(N)) :-
  154.     $asm_opgen_even(34), 
  155.     $write4(N).
  156. $asm_gen(bldfloatcon(N)) :-
  157.     $asm_opgen_even(35),
  158.     $write4(N).
  159.  
  160. $asm_gen(switchonterm(R,L,L1)) :-
  161.     $asm_opgen(176), $asm_putnum(R,1),  $asm_putnum(L,4), $asm_putnum(L1,4).
  162. $asm_gen(arg(R1,R2,R3)) :-
  163.     $asm_opgen(177), $asm_putnum(R1,1), $asm_putnum(R2,1), $asm_putnum(R3,1).
  164. $asm_gen(arg0(R1,R2,R3)) :-
  165.     $asm_opgen(178), $asm_putnum(R1,1), $asm_putnum(R2,1), $asm_putnum(R3,1).
  166. $asm_gen(switchonbound(R, L, L1)) :-
  167.     $asm_opgen(179), $asm_putnum(R,1), $asm_putnum(L,4), $asm_putnum(L1, 4).
  168. $asm_gen(switchonlist(R,L,L1)) :-
  169.     $asm_opgen(180), $asm_putnum(R,1),  $asm_putnum(L,4), $asm_putnum(L1,4).
  170.  
  171. $asm_gen(get_tag(R1,R2)) :-
  172.     $asm_opgen_even(191), $asm_putnum(R1,1), $asm_putnum(R2,1).
  173.  
  174. $asm_gen(movreg(R,R1)) :-
  175.     $asm_opgen_even(209), $asm_putnum(R,1), $asm_putnum(R1,1).
  176.  
  177. $asm_gen(negate(R)) :- $asm_opgen(210), $asm_putnum(R,1).
  178. $asm_gen(and(R,R1)) :-
  179.     $asm_opgen_even(211), $asm_putnum(R,1), $asm_putnum(R1,1).
  180. $asm_gen(or(R,R1)) :-
  181.     $asm_opgen_even(212), $asm_putnum(R,1), $asm_putnum(R1,1).
  182. $asm_gen(lshiftl(R,R1)) :-
  183.     $asm_opgen_even(213), $asm_putnum(R,1), $asm_putnum(R1,1).
  184. $asm_gen(lshiftr(R,R1)) :-
  185.     $asm_opgen_even(214), $asm_putnum(R,1), $asm_putnum(R1,1).
  186. $asm_gen(addreg(R,R1)) :-
  187.     $asm_opgen_even(215), $asm_putnum(R,1), $asm_putnum(R1,1).
  188. $asm_gen(subreg(R,R1)) :-
  189.     $asm_opgen_even(216), $asm_putnum(R,1), $asm_putnum(R1,1).
  190. $asm_gen(mulreg(R,R1)) :-
  191.     $asm_opgen_even(217), $asm_putnum(R,1), $asm_putnum(R1,1).
  192. $asm_gen(divreg(R,R1)) :-
  193.     $asm_opgen_even(218), $asm_putnum(R,1), $asm_putnum(R1,1).
  194. $asm_gen(idivreg(R,R1)) :-
  195.     $asm_opgen_even(219), $asm_putnum(R,1), $asm_putnum(R1,1).
  196.  
  197. $asm_gen(trymeelse(L,A)) :-
  198.     $asm_opgen(160), $asm_putnum(A,1), $asm_putnum(L,4).
  199. $asm_gen(retrymeelse(L,A)) :-
  200.     $asm_opgen(161),  $asm_putnum(A,1), $asm_putnum(L,4).
  201. $asm_gen(trustmeelsefail(A)) :- $asm_opgen(162), $asm_putnum(A,1).
  202. $asm_gen(try(L,A)) :- $asm_opgen(163),  $asm_putnum(A,1), $asm_putnum(L,4).
  203. $asm_gen(retry(L,A)) :- $asm_opgen(164), $asm_putnum(A,1), $asm_putnum(L,4).
  204. $asm_gen(trust(L,A)) :- $asm_opgen(165),  $asm_putnum(A,1), $asm_putnum(L,4).
  205.  
  206. $asm_gen(getpbreg(V)) :- $asm_opgen(166), $asm_putnum(V,1).
  207. $asm_gen(gettbreg(R)) :- $asm_opgen(167), $asm_putnum(R,1).
  208. $asm_gen(putpbreg(V)) :- $asm_opgen(168), $asm_putnum(V,1).
  209. $asm_gen(puttbreg(R)) :- $asm_opgen(169), $asm_putnum(R,1).
  210.  
  211. $asm_gen(putdval(V,R)) :-
  212.     $asm_opgen_even(224), $asm_putnum(V,1), $asm_putnum(R,1).
  213. $asm_gen(putuval(V,R)) :-
  214.     $asm_opgen_even(225), $asm_putnum(V,1), $asm_putnum(R,1).
  215.  
  216. $asm_gen(call(I,B)) :- $asm_opgen(232), $asm_putnum(B,1), $asm_putnum(I,4).
  217. $asm_gen(allocate) :- $asm_opgen_even(233).
  218. $asm_gen(deallocate) :- $asm_opgen_even(234).
  219. $asm_gen(proceed) :- $asm_opgen_even(235).
  220. $asm_gen(execute(I)) :- $asm_opgen_even(236), $asm_putnum(I,4).
  221. $asm_gen(calld(L,B)) :- $asm_opgen(239), $asm_putnum(B,1), $asm_putnum(L,4).
  222.  
  223. $asm_gen(jump(L)) :- $asm_opgen_even(240), $asm_putnum(L,4).
  224. $asm_gen(jumpz(R,L)) :- $asm_opgen(241), $asm_putnum(R,1), $asm_putnum(L,4).
  225. $asm_gen(jumpnz(R,L)) :- $asm_opgen(242), $asm_putnum(R,1), $asm_putnum(L,4).
  226. $asm_gen(jumplt(R,L)) :- $asm_opgen(243), $asm_putnum(R,1), $asm_putnum(L,4).
  227. $asm_gen(jumple(R,L)) :- $asm_opgen(244), $asm_putnum(R,1), $asm_putnum(L,4).
  228. $asm_gen(jumpgt(R,L)) :- $asm_opgen(245), $asm_putnum(R,1), $asm_putnum(L,4).
  229. $asm_gen(jumpge(R,L)) :- $asm_opgen(246), $asm_putnum(R,1), $asm_putnum(L,4).
  230.  
  231. $asm_gen(fail) :- $asm_opgen_even(248).
  232. $asm_gen(noop) :- $asm_opgen_even(249).
  233. $asm_gen(halt) :- $asm_opgen_even(250). 
  234. $asm_gen(builtin(W)) :- $asm_opgen(251), $asm_putnum(W,1).
  235.  
  236. $asm_mark_eot :- $asm_opgen_even(255),$asm_putnum(0,4).
  237.  
  238. /* ---------------------------------------------------------------------- */
  239.